home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtrandom.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  4.8 KB  |  145 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *         MAGIC   Modula's  All purpose  GEM  Interface  Cadre         *
  4.  *                 ÿ         ÿ            ÿ    ÿ          ÿ             *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus in schrift-  *
  11.  * licher Form, insbesondere in Zeitschriften, sowie die Verbreitung    *
  12.  * ber Public-Domain-H„ndler bedarf der ausdrcklichen schriftlichen   *
  13.  * Genehmigung des Autors!                                              *
  14.  *                                                                      *
  15.  * Der Autor gibt hiermit die ausdrckliche Erlaubnis, das Modul jeder- *
  16.  * zeit auch im Quelltext weiterzugegeben, sofern dessen Text und ins-  *
  17.  * besondere dieser Urheberrechts-Vermerk nicht ver„ndert wird, und     *
  18.  * durch die Weitergabe kein finanzieller Nutzen entsteht. Der Autor    *
  19.  * beh„lt sich das Recht vor, diese Erlaubnis jederzeit u. ohne Angaben *
  20.  * von Grnden zu widerrufen.                                           *
  21.  *----------------------------------------------------------------------*)
  22.  
  23. IMPLEMENTATION MODULE mtRandom;
  24.  
  25. (*----------------------------------------------------------------------*
  26.  * Int. Vers | Datum    | Name | Žnderung                               *
  27.  *-----------+----------+------+----------------------------------------*
  28.  *  3.00     | 18.01.92 |  Hp  |                                        *
  29.  *-----------+----------+------+----------------------------------------*)
  30.  
  31.  
  32.  
  33. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  34. (*                                              *)
  35. (*$R-   Range-Checks                            *)
  36. (*$S-   Stack-Check                             *)
  37. (*                                              *)
  38. (*----------------------------------------------*)
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  46.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  47.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  48.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  49.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  50.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  51.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  52.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59. IMPORT MagicDOS, mtTime;
  60.  
  61. CONST   C =     54;
  62.  
  63. VAR     a:      ARRAY [0..C] OF lCARDINAL;
  64.         j, k:   [0..C];
  65.  
  66.  
  67. PROCEDURE Next (): lCARDINAL;
  68. BEGIN
  69.  a[k]:= a[k] + a[j];
  70.  IF k = 0 THEN  k:= C;  ELSE  DEC (k);  END;
  71.  IF j = 0 THEN  j:= C;  ELSE  DEC (j);  END;
  72.  RETURN a[k];
  73. END Next;
  74.  
  75. PROCEDURE RandomInit (initial: sCARDINAL);
  76. VAR i: sCARDINAL;
  77.     d: lCARDINAL;
  78. BEGIN
  79.  j:= 24; k:= 0;
  80.  FOR i:= 0 TO C DO a[i]:= 0;  END;
  81.  a[k]:= LONG (31415 + initial);
  82.  IF a[k] = 0 THEN  a[k]:= 31415;  END;
  83.  FOR i:= 0 TO 1999 DO  d:= Next ();  END;
  84. END RandomInit;
  85.  
  86. PROCEDURE Randomize;
  87. VAR time, h, m, s, i, j: sCARDINAL;
  88.     l: lCARDINAL;
  89. BEGIN
  90.  time:= MagicDOS.Tgettime ();
  91.  mtTime.DecodeTime (time, h, m, s);
  92.  RandomInit (s);
  93.  j:= m * s;
  94.  FOR i:= 0 TO j DO  l:= Next ();  END;
  95. END Randomize;
  96.  
  97. PROCEDURE RndLCard (max: lCARDINAL): lCARDINAL;
  98. BEGIN
  99.  IF max = 0 THEN
  100.   RETURN Next();
  101.  ELSE
  102.   RETURN TRUNC  (FLOAT  (max) * FLOAT  (Next()) / FLOAT  (MAX(lCARDINAL))); 
  103.  END;
  104. END RndLCard;
  105.  
  106. PROCEDURE RndCard (max: sCARDINAL): sCARDINAL;
  107. BEGIN
  108.  RETURN SHORT (RndLCard (LONG(max)));
  109. END RndCard;
  110.  
  111. PROCEDURE RndInt (max: sINTEGER): sINTEGER;
  112. BEGIN
  113.  RETURN SHORT (RndLInt (LONG(max)));
  114. END RndInt;
  115.  
  116. PROCEDURE RndLInt (max: lINTEGER): lINTEGER;
  117. VAR l: lCARDINAL;
  118. BEGIN
  119.  IF max = 0 THEN  l:= RndLCard (MAX (lINTEGER));
  120.             ELSE  l:= RndLCard (ABS (max));
  121.  END;
  122.  RETURN ABS (CastToLInt (l));
  123. END RndLInt;
  124.  
  125. PROCEDURE RndReal (): REAL;
  126. BEGIN
  127.  RETURN FLOAT (RndCard (10000)) * 1.0E-16 +
  128.         FLOAT (RndCard (10000)) * 1.0E-12 +
  129.         FLOAT (RndCard (10000)) * 1.0E-08 +
  130.         FLOAT (RndCard (10000)) * 1.0E-04;
  131. END RndReal;
  132.  
  133. PROCEDURE RndLReal (): LONGREAL;
  134. BEGIN
  135.  RETURN FLOAT (RndCard (10000)) * 1.0E-16 +
  136.         FLOAT (RndCard (10000)) * 1.0E-12 +
  137.         FLOAT (RndCard (10000)) * 1.0E-08 +
  138.         FLOAT (RndCard (10000)) * 1.0E-04;
  139. END RndLReal;
  140.  
  141. BEGIN 
  142.  Randomize;
  143. END mtRandom.
  144.  
  145.